home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 (Alt) / MACD 5.bin / workbench / blankery / blitzblank / sources / bb.pyro_gc < prev    next >
Encoding:
Text File  |  1993-09-17  |  8.9 KB  |  414 lines
  1. ;BB.Pyro_GC - Blanker-module for BlitzBlank
  2. ;Copyright 1993 by Thomas Boerkel
  3.  
  4. CloseEd
  5.  
  6. NEWTYPE.spritedata
  7. a.w
  8. b
  9. c
  10. d
  11. e
  12. f
  13. End NEWTYPE
  14.  
  15. NEWTYPE.tags
  16. a.l
  17. b
  18. c
  19. d
  20. e
  21. f
  22. End NEWTYPE
  23.  
  24. DEFTYPE.spritedata *sprdata
  25. DEFTYPE.Screen *myscreen,*myscreen2
  26. DEFTYPE.ColorMap *cm
  27. DEFTYPE.NewScreen newscreen
  28. DEFTYPE.Window *mywindow
  29. DEFTYPE.NewWindow newwindow
  30. DEFTYPE.Message *msg
  31. DEFTYPE.MsgPort *port
  32. DEFTYPE.tags tags
  33.  
  34. Statement stringborder{x,y,w,h}
  35. Wline x+1,y+h+2,x+1,y,x+w+8,y,1
  36. Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
  37. Wline x,y+h+3,x,y,1
  38. Wline x+w+11,y-1,x+w+11,y+h+4,1
  39. Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
  40. Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
  41. Wline x-2,y+h+4,x-2,y-1,2
  42. Wline x+w+8,y+1,x+w+8,y+h+2,2
  43. End Statement
  44.  
  45.  
  46. Select Par$(1)
  47.  
  48.   Case "BLANK"
  49.  
  50.     name$="BB.BlankModule"+Chr$(0)
  51.     *port=CreateMsgPort_()
  52.     *port\mp_Node\ln_Name=&name$
  53.     *port\mp_Node\ln_Pri=1
  54.     AddPort_ *port
  55.     n=0
  56.     Gosub readconfig
  57.     SetTaskPri_ FindTask_(0),Val(Par$(8))
  58.     Dim xf(n+1,9)
  59.     Dim yf(n+1,9)
  60.     Dim xk(2,n+1,9)
  61.     Dim yk(2,n+1,9)
  62.     Dim wg(9)
  63.  
  64.     Dim va(n+1)
  65.     Dim xa(n+1)
  66.     Dim t(n+1)
  67.     Dim t2(n+1)
  68.     Dim et(n+1)
  69.     Dim sinwb(n+1)
  70.     Dim coswb(n+1)
  71.     Dim x(2,n+1)
  72.     Dim y(2,n+1)
  73.     Dim f(n+1)
  74.     Dim c(n+1)
  75.     *sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR)
  76.     newwindow\LeftEdge=0,0,1,1
  77.     newwindow\Flags=#WFLG_ACTIVATE
  78.     newwindow\FirstGadget=0,0,0,0,0,-1,-1,-1,-1,#WBENCHSCREEN
  79.  
  80.     *mywindow=OpenWindow_(newwindow)
  81.  
  82.     VWait
  83.     SetPointer_ *mywindow,*sprdata,0,0,0,0
  84.  
  85.  
  86.  
  87.     width.l=Val(Par$(2))
  88.     height.l=Val(Par$(3))
  89.  
  90.     mode.l=Val(Par$(4))
  91.     monitor.l=Val(Par$(5))
  92.  
  93.     depth.w=Val(Par$(6))
  94.     colors.w=2^depth
  95.  
  96.  
  97.     Dim *vp.ViewPort(2)
  98.     Dim *rp.RastPort(2)
  99.  
  100.     title1$="BB.Pyro0"+Chr$(0)
  101.     newscreen\LeftEdge=0,0,width,height,depth
  102.     newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title1$
  103.     tags\a=#SA_DisplayID
  104.     tags\b=$10000*monitor+mode
  105.     tags\c=0
  106.     *myscreen=OpenScreenTagList_(newscreen,tags)
  107.     If db
  108.       title2$="BB.Pyro1"+Chr$(0)
  109.       newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title2$
  110.       *myscreen2=OpenScreenTagList_(newscreen,tags)
  111.     EndIf
  112.  
  113.     If *myscreen AND (db=0 OR *myscreen2)
  114.       *vp(0)=*myscreen\ViewPort
  115.       *rp(0)=*myscreen\RastPort
  116.       If db
  117.         *vp(1)=*myscreen2\ViewPort
  118.         *rp(1)=*myscreen2\RastPort
  119.       EndIf
  120.       For i=0 To db
  121.         SetRGB4_ *vp(i),0,0,0,0
  122.         SetRGB4_ *vp(i),1,15,15,0
  123.         If colors>2
  124.           SetRGB4_ *vp(i),2,0,10,15
  125.           SetRGB4_ *vp(i),3,15,7,0
  126.           If colors>4
  127.             SetRGB4_ *vp(i),4,0,15,0
  128.             SetRGB4_ *vp(i),5,15,3,8
  129.             SetRGB4_ *vp(i),6,15,5,15
  130.             SetRGB4_ *vp(i),7,5,15,8
  131.             If colors>8
  132.               SetRGB4_ *vp(i),8,15,0,0
  133.               SetRGB4_ *vp(i),9,0,15,0
  134.               SetRGB4_ *vp(i),10,0,0,15
  135.               SetRGB4_ *vp(i),11,0,7,15
  136.               SetRGB4_ *vp(i),12,8,15,3
  137.               SetRGB4_ *vp(i),13,15,10,0
  138.               SetRGB4_ *vp(i),14,7,0,15
  139.               SetRGB4_ *vp(i),15,3,8,15
  140.             EndIf
  141.           EndIf
  142.         EndIf
  143.         SetAPen_ *rp(i),0
  144.         RectFill_ *rp(i),0,0,width-1,height-1
  145.       Next i
  146.  
  147.       If db=0
  148.         ScreenToFront_ *myscreen
  149.       EndIf
  150.  
  151.       g=0.1
  152.       vamax=Sqr(2*(height-1)*g)/Sin(90*Pi/180)
  153.       ve=vamax/4
  154.  
  155.       For i=1 To 6
  156.         wg(i)=Pi/3*i
  157.       Next i
  158.  
  159.       Dim si.q(631)
  160.       Dim co.q(631)
  161.  
  162.       For i=0 To 630
  163.         f=i/100
  164.         si(i)=Sin(f)
  165.         co(i)=Cos(f)
  166.       Next i
  167.  
  168.  
  169.  
  170.       Repeat
  171.         If db
  172.         Else
  173.           VWait
  174.         EndIf
  175.         For j=1 To n
  176.           If f(j)=0
  177.             f(j)=1
  178.             wa=Rnd(40)+70
  179.             wb=wa*Pi/180
  180.             sinwb(j)=si(Int(wb*100))
  181.             coswb(j)=co(Int(wb*100))
  182.             xa(j)=width/2
  183.             va(j)=Rnd(vamax/3)+vamax/3*2
  184.  
  185.             et(j)=Int(Rnd(40)+(va(j)*sinwb(j))/g)
  186.             c(j)=Rnd(colors-1)+1
  187.           Else
  188.             If t(j)<et(j)
  189.               SetAPen_ *rp(s),0
  190.               WritePixel_ *rp(s),x(s,j),y(s,j)
  191.  
  192.               x(s,j)=xa(j)+va(j)*coswb(j)*t(j)
  193.               y(s,j)=height-1-va(j)*sinwb(j)*t(j)+0.5*g*t(j)*t(j)
  194.               SetAPen_ *rp(s),c(j)
  195.               WritePixel_ *rp(s),x(s,j),y(s,j)
  196.  
  197.               t(j)+.5
  198.             EndIf
  199.  
  200.             If t(j)=et(j)+1 AND t2(j)<15
  201.               For i=1 To 6
  202.                 SetAPen_ *rp(s),0
  203.                 WritePixel_ *rp(s),xk(s,j,i),yk(s,j,i)
  204.                 WritePixel_ *rp(s),xk(s,j,i)+1,yk(s,j,i)
  205.  
  206.  
  207.                 xk(s,j,i)=x(0,j)+xf(j,i)*t2(j)
  208.                 yk(s,j,i)=y(0,j)+yf(j,i)*t2(j)+0.5*g*t2(j)*t2(j)
  209.                 SetAPen_ *rp(s),c(j)
  210.                 WritePixel_ *rp(s),xk(s,j,i),yk(s,j,i)
  211.                 WritePixel_ *rp(s),xk(s,j,i)+1,yk(s,j,i)
  212.  
  213.  
  214.               Next i
  215.               t2(j)+.5
  216.             EndIf
  217.  
  218.             If t(j)=et(j)
  219.               SetAPen_ *rp(s),0
  220.               WritePixel_ *rp(s),x(s,j),y(s,j)
  221.  
  222.               If db
  223.                 SetAPen_ *rp(1-s),0
  224.                 WritePixel_ *rp(1-s),x(1-s,j),y(1-s,j)
  225.  
  226.               EndIf
  227.               For i=1 To 6
  228.  
  229.  
  230.                 xf(j,i)=va(j)*coswb(j)+ve*co(Int(wg(i)*100))
  231.                 yf(j,i)=ve*si(Int(wg(i)*100))-va(j)*sinwb(j)+g*t(j)
  232.                 xk(s,j,i)=0
  233.                 yk(s,j,i)=0
  234.                 If db
  235.                   xk(1-s,j,i)=0
  236.                   yk(1-s,j,i)=0
  237.                 EndIf
  238.               Next i
  239.               t(j)+1
  240.             EndIf
  241.  
  242.  
  243.  
  244.             If t2(j)>15
  245.               For i=1 To 6
  246.                 SetAPen_ *rp(s),0
  247.                 WritePixel_ *rp(s),xk(s,j,i),yk(s,j,i)
  248.                 WritePixel_ *rp(s),xk(s,j,i)+1,yk(s,j,i)
  249.  
  250.               Next i
  251.               If db
  252.                 For i=1 To 6
  253.                   SetAPen_ *rp(1-s),0
  254.                   WritePixel_ *rp(1-s),xk(1-s,j,i),yk(1-s,j,i)
  255.                   WritePixel_ *rp(1-s),xk(1-s,j,i)+1,yk(1-s,j,i)
  256.  
  257.                 Next i
  258.               EndIf
  259.  
  260.               t2(j)=0
  261.               t(j)=0
  262.               et(j)=0
  263.               f(j)=0
  264.             EndIf
  265.  
  266.             If t2(j)=15
  267.               t2(j)=16
  268.             EndIf
  269.           EndIf
  270.         Next j
  271.         *msg=GetMsg_(*port)
  272.         If db
  273.           If s
  274.             ScreenToFront_ *myscreen2
  275.           Else
  276.             ScreenToFront_ *myscreen
  277.           EndIf
  278.           s=1-s
  279.         EndIf
  280.  
  281.       Until *msg
  282.       CloseScreen_ *myscreen
  283.       If db
  284.         CloseScreen_ *myscreen2
  285.       EndIf
  286.     EndIf
  287.     ClearPointer_ *mywindow
  288.     CloseWindow_ *mywindow
  289.     FreeMem_ *sprdata,SizeOf.spritedata
  290.     RemPort_ *port
  291.     DeleteMsgPort_ *port
  292.  
  293.  
  294.  
  295.   Case "INFO"
  296.     title$="Pyro_GC"+Chr$(0)
  297.     reqtext$="Pyro_GC - Module for BlitzBlank"+Chr$(10)
  298.     reqtext$+Chr$(169)+" 1993 by Thomas Brkel + Wolfgang Brkel"+Chr$(10)+Chr$(10)
  299.     reqtext$+"You see fireworks on a black screen."+Chr$(10)
  300.     reqtext$+"This is the graphic-cards-version of Pyro."+Chr$(10)+Chr$(10)
  301.     reqtext$+"Choose the number of flares and the doublebuffering"+Chr$(10)
  302.     reqtext$+"in the config-window."+Chr$(0)
  303.     gadget$="OK"+Chr$(0)
  304.     easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
  305.     easy\es_Title=&title$
  306.     easy\es_TextFormat=&reqtext$
  307.     easy\es_GadgetFormat=&gadget$
  308.     EasyRequestArgs_ 0,easy,0,0
  309.  
  310.   Case "CONFIG"
  311.     *myscreen=LockPubScreen_(0)
  312.     width=*myscreen\Width
  313.     height=*myscreen\Height
  314.     font=*myscreen\Font\ta_YSize
  315.     Gosub readconfig
  316.     WbToScreen 0
  317.  
  318.  
  319.     BorderPens 0,0
  320.     StringGadget 0,100,45,0,0,4,30
  321.     BorderPens 2,1
  322.     TextGadget 0,37,20,1,1,"Doublebuffer"
  323.     If db
  324.       Toggle 0,1,On
  325.     EndIf
  326.     Window 0,width/2-90,height/2-35,180,70,$100e,"Pyro",1,2,0
  327.     stringborder{100,45,30,8}
  328.     WColour 2
  329.     WLocate 32,44-font
  330.     Print "Flares:"
  331.     WLocate 32,44-font+8
  332.     Print "(1-50)"
  333.     SetString 0,0,Str$(n)
  334.     ActivateString 0,0
  335.     Repeat
  336.       ev=WaitEvent
  337.     Until ev=$200 OR (ev=$40 AND GadgetHit=0)
  338.     n=Val(StringText$(0,0))
  339.     If GadgetStatus(0,1)
  340.       db=1
  341.     Else
  342.       db=0
  343.     EndIf
  344.     Free Window 0
  345.     Gosub writeconfig
  346.     UnlockPubScreen_ 0,*myscreen
  347.  
  348. End Select
  349.  
  350. End
  351.  
  352. .readconfig
  353. path$=Par$(9)
  354. For i=10 To NumPars
  355.   path$=path$+" "+Par$(i)
  356. Next i
  357. If ReadFile(0,path$+"BB.Modules.config")
  358.   FileInput 0
  359.   While NOT Eof(0)
  360.     If Edit$(100)="*** Pyro ***"
  361.       n=Edit(5)
  362.       db=Edit(5)
  363.     EndIf
  364.   Wend
  365.   DefaultInput
  366.   CloseFile 0
  367. EndIf
  368. Gosub checkval
  369. Return
  370.  
  371.  
  372. .writeconfig
  373. Gosub checkval
  374. If ReadFile(0,path$+"BB.Modules.config")
  375.   If WriteFile(1,path$+"BB.Modules.temp")
  376.     FileInput 0
  377.     FileOutput 1
  378.     While NOT Eof(0)
  379.       f$=Edit$(100)
  380.       If f$="*** Pyro ***"
  381.         Repeat
  382.           f2$=Edit$(100)
  383.         Until Eof(0) OR Left$(f2$,3)="***"
  384.         If NOT Eof(0) Then NPrint f2$
  385.       Else
  386.         NPrint f$
  387.       EndIf
  388.     Wend
  389.     CloseFile 1
  390.   EndIf
  391.   CloseFile 0
  392. EndIf
  393. KillFile path$+"BB.Modules.config"
  394. f$=path$+"BB.Modules.temp"+Chr$(0)
  395. f2$=path$+"BB.Modules.config"+Chr$(0)
  396. Rename_ &f$,&f2$
  397. If OpenFile(0,path$+"BB.Modules.config")
  398.   FileOutput 0
  399.   FileSeek 0,Lof(0)
  400.   NPrint "*** Pyro ***"
  401.   NPrint n
  402.   NPrint db
  403.   CloseFile 0
  404. EndIf
  405. Return
  406.  
  407. .checkval
  408. If n<1 Then n=10
  409. If n>50 Then n=10
  410. If db<0 Then db=0
  411. If db>1 Then db=1
  412. Return
  413.  
  414.